home *** CD-ROM | disk | FTP | other *** search
/ Aminet 25 / Aminet 25 (1998)(GTI - Schatztruhe)[!][Jun 1998].iso / Aminet / comm / thor / DLManager.lha / DLManager.thor < prev   
Text File  |  1998-03-31  |  14KB  |  671 lines
  1. /*
  2. **   $Filename: DLManager.thor
  3. **
  4. **   $VER: DLManager v1.7 ©1996-1998
  5. **
  6. **   Copyright 1996-1998, Troy E. Bouchard.
  7. **
  8. **   Author: Troy E. Bouchard
  9. **   E-Mail: tbouchar@ptialaska.net
  10. **
  11. **   Library Files needed:
  12. **         bbsread.library (of course)
  13. **         rexxarplib.library (get it from Aminet!)
  14. **         rexxsupport.library (get it from Aminet!)
  15. **
  16. */
  17.  
  18. SIGNAL ON SYNTAX
  19. SIGNAL ON HALT
  20.  
  21. EVE_ENTERMSG = 0
  22.  
  23. NL = '0a'x
  24.  
  25. /* Find our Thor Port and number! */
  26. p = Address() || ' ' || show('P',,)
  27.     ThorPort = pos('THOR.',p)
  28.  
  29.     if ThorPort > 0 then ThorPort = word(substr(p,ThorPort),1)
  30. else
  31.     do
  32.     say "Can't seem to find the Thor port!"
  33.     exit 10
  34.     End
  35.  
  36. /* Load the BBSRead library up! */
  37. if ~show('p', 'BBSREAD') then
  38. do
  39.    address command
  40.       "run >nil: `GetEnv THOR/THORPath`bin/LoadBBSRead"
  41.      "WaitForPort BBSREAD"
  42. End
  43.  
  44. if ~Show('L','rexxarplib.library') then
  45. do
  46.    if ~AddLib('rexxarplib.library',0,-30,0) then
  47.    do
  48.       Address(ThorPort)
  49.       'REQUESTNOTIFY TEXT '"Couldn't open rexxarplib.library"' BT "_Exiting!"'
  50.       exit 5
  51.    end
  52. end
  53.  
  54. if ~Show('L','rexxsupport.library') then
  55. do
  56.    if ~AddLib('rexxsupport.library',0,-30,0) then
  57.    do
  58.       Address(ThorPort)
  59.       'REQUESTNOTIFY TEXT '"Couldn't open rexxsupport.library"' BT "_Exiting!"'
  60.       exit 5
  61.    end
  62. end
  63.  
  64. options results
  65.  
  66. MyPort = OpenPort(DLPORT)
  67. if MyPort = 0 then
  68. do
  69.    Address(ThorPort)
  70.    'REQUESTNOTIFY TEXT '"Couldn't open the port"' BT "_Exiting!"'
  71.    exit 5
  72. end
  73.  
  74. address AREXX ,
  75.       "'Call CreateHost(DLHOST,DLPORT)'"
  76.  
  77. do i = 1 to 10
  78.    if ~Showlist('P',DLHOST) then call delay 50
  79.    else leave i
  80. end
  81.  
  82. if i = 10 & ~Showlist('P',DLHOST) then
  83. do
  84.    Address(ThorPort)
  85.    'REQUESTNOTIFY TEXT '"Couldn't open the Host"' BT "_Exiting!"'
  86.    exit 5
  87. end
  88.  
  89. Address(ThorPort)
  90. 'WBToFront'
  91.  
  92. Call GetVersion
  93.  
  94. $vers = VER.THOR
  95. $date = Translate(Date(),," ","-")
  96. $tim = $date||' '||Time()
  97.  
  98. Address(ThorPort)
  99. 'CurrentSystem Stem "'Current'"'
  100. if(rc = 30) then
  101. do
  102.    'RequestNotify TEXT '"Couldn't get the system"' BT "_OH Darn"'
  103.    Call Cleanup
  104. end
  105.  
  106. TB_SYSTEM = Current.BBSNAME
  107.  
  108. Call CreateWIN()
  109.  
  110. WaitStuff:
  111.    fini = 0
  112.  
  113.    do forever
  114.       if fini = 1 then leave
  115.       t = waitpkt(DLPORT)
  116.       do i = 1
  117.      p = getpkt(DLPORT)
  118.      if c2d(p) = 0 then leave i
  119.      cmd = getarg(p)
  120.      j = reply(p,0)
  121.      Select
  122.         When cmd = CLOSEWINDOW then do
  123.            Call Quit()
  124.         end
  125.         When cmd = GETSYSTEM then do
  126.            Call GetSystem()
  127.            win.txt = '   Current System: 'TB_SYSTEM
  128.            Call WindowText(DLHOST, win.txt)
  129.         end
  130.         When cmd = NEWLIST then do
  131.            Call NewList()
  132.         end
  133.         When cmd = WRITEMSG then do
  134.            Call WriteMSG()
  135.         end
  136.         When cmd = DELLIST then do
  137.            Call DeleteList
  138.         end
  139.         When cmd = QUIT then do
  140.            Call Quit()
  141.         end
  142.         When cmd = ABOUT then do
  143.            Call About
  144.         end
  145.         When cmd = EDIT then do
  146.            Call Edit
  147.         end
  148.         When cmd = DELETEU then do
  149.            Call DelUser()
  150.         end
  151.         otherwise nop
  152.      end
  153.       end
  154.    end
  155. Return
  156.  
  157. CreateWIN:
  158.    voffseta=0
  159.    voffsetb=0
  160.    gad. = ""
  161.    gad.0 = 28
  162.  
  163.    win.idcmp = "+CLOSEWINDOW+GADGETUP"
  164.    win.flags = "+WINDOWCLOSE+WINDOWDEPTH+BACKFILL+ACTIVATE"
  165.    win.title = "DLManager v1.7"
  166.  
  167.    gad.1.x = 30
  168.    gad.1.y = 38+voffseta
  169.    gad.1.name = "GETSYSTEM"
  170.    gad.1.text = " Get System "
  171.    gad.1.reportstring = "%d"
  172.  
  173.    gad.2.x = 30
  174.    gad.2.y = 56+voffseta
  175.    gad.2.name = "NEWLIST"
  176.    gad.2.text = "New/Add List"
  177.    gad.2.reportstring = "%d"
  178.  
  179.    gad.3.x = 156
  180.    gad.3.y = 38+voffseta
  181.    gad.3.name = "WRITEMSG"
  182.    gad.3.text = " Write Mesg "
  183.    gad.3.reportstring = "%d"
  184.  
  185.    gad.4.x = 156
  186.    gad.4.y = 56+voffseta
  187.    gad.4.name = "DELLIST"
  188.    gad.4.text = " Delete List"
  189.    gad.4.reportstring = "%d"
  190.  
  191.    gad.5.x = 30
  192.    gad.5.y = 74+voffseta
  193.    gad.5.name = "QUIT"
  194.    gad.5.text = "    Quit    "
  195.    gad.5.reportstring = "%d"
  196.  
  197.    gad.6.x = 156
  198.    gad.6.y = 74+voffseta
  199.    gad.6.name = "ABOUT"
  200.    gad.6.text = "    About   "
  201.    gad.6.reportstring = "%d"
  202.  
  203.    gad.7.x = 30
  204.    gad.7.y = 92+voffseta
  205.    gad.7.name = "EDIT"
  206.    gad.7.text = "    Edit    "
  207.    gad.7.reportstring = "%d"
  208.  
  209.    gad.8.x = 156
  210.    gad.8.y = 92+voffseta
  211.    gad.8.name = "DELETEU"
  212.    gad.8.text = " Delete User"
  213.    gad.8.reportstring = "%d"
  214.  
  215.    call SetReqColor(DLHOST,BACKGROUND,0) /* Color the Background */
  216.  
  217. /* Open the window and set the gadgets! */
  218.    call OpenWindow(DLHOST, 0, 0, 285, 112, win.idcmp, win.flags, win.title)
  219.  
  220.    window.text = '   Current System: 'TB_SYSTEM
  221.    Call WindowText(DLHOST, window.text)
  222.  
  223.    CNT = 0
  224.  
  225.    do n = 1 to gad.CNT
  226.       if gad.n.length = "" then
  227.      call Addgadget(DLHOST, gad.n.x, gad.n.y, ,
  228.         gad.n.name, gad.n.text, gad.n.reportstring)
  229.       else
  230.      call Addgadget(DLHOST, gad.n.x, gad.n.y, ,
  231.         gad.n.name, gad.n.text, gad.n.reportstring, ,
  232.            gad.n.length)
  233.    end
  234.  
  235. /* Color the Gadgets and activate em! (set activate -> ON
  236.    Call SetGadget(DLHOST, GETSYSTEM, ON)
  237.    Call SetGadget(DLHOST, NEWLIST,   ON)
  238.    Call SetGadget(DLHOST, WRITEMSG,  ON)
  239.    Call SetGadget(DLHOST, DELLIST,   ON)
  240.    Call SetGadget(DLHOST, QUIT,      ON)
  241.    Call SetGadget(DLHOST, ABOUT,     ON)
  242.    Call SetGadget(DLHOST, EDIT,      ON) */
  243. Return
  244.  
  245.  
  246. AddTDL:
  247.    Call GetSystemPath()
  248.  
  249.    Address(ThorPort)
  250.    'RequestFile Title "Select the .tdl file" ID "'DataPath'".tdl FP PAT "#?.tdl"'
  251.    if(rc = 5) then
  252.    do
  253.       'RequestNotify Text "Request Aborted!" BT "_Wow!"'
  254.       Call WaitStuff
  255.    end
  256.  
  257.    choice = result
  258.  
  259.    if ~Exists(choice) then
  260.    do
  261.       Call Open out, choice, 'w'
  262.       Call Close out
  263.    end
  264. Return(Choice)
  265.  
  266. NewList:
  267.    Call AddTDL
  268.    Call AutoManAdd
  269. Return
  270.  
  271. WriteCC:
  272.    Address BBSRead
  273.    'BufMode CopyBack'
  274.    CCAddrStr = ''
  275.    hdr = 'Cc: '
  276.    blnk = ''
  277.    WAddressStr = hdr||ADDR.i
  278.    i=i+1
  279.    Do j = i to ADDR.COUNT
  280.       Interpret 'NextAddress = ADDR.'j
  281.       if Length(WAddressStr','NextAddress) > 250 then
  282.       do
  283.      CCAddrStr = CCAddrStr||WAddressStr||','||'0a'x
  284.      WaddressStr = blnk
  285.       End
  286.       else WAddressStr = WAddressStr','
  287.       WAddressStr = WAddressStr||NextAddress
  288.    End
  289.    if WAddressStr > '' then CCAddrStr = CCAddrStr||WAddressStr||'0a'x
  290.  
  291.    Call Open out, DataPath||EVENT.MSGFILE, 'A'
  292.    Call WriteLN out, CCAddrStr
  293.    Call Close out
  294.  
  295.    'BufMode EndCopyBack'
  296. Return
  297.  
  298. WriteMSG:
  299.    Call AddTDL()      /* get the distribution list         */
  300.    Call GetSystemPath()   /* get the pathway for the system  */
  301.  
  302.    Drop EVENT. /* make sure you free up the event */
  303.    Drop Addr.  /* make sure you free up the event */
  304.  
  305.    address(BBSREAD)
  306.    'UNIQUEMSGFILE bbsname "'TB_SYSTEM'" stem "'TDLFILE'"'
  307.    if(rc ~= 0) then
  308.    do
  309.       Address(ThorPort)
  310.       'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  311.       Call WaitStuff
  312.    end
  313.  
  314.    EVENT.CONFERENCE = 'EMail'
  315.    EVENT.MSGFILE    = TDLFILE.FILEPART
  316.  
  317.    Call Open out, Choice, 'R'
  318.  
  319.    n = 0
  320.    do while ~eof(out)
  321.       Address = readln(out)
  322.       if Address = '' then leave
  323.       n = n+1
  324.       Interpret 'ADDR.'n' = Address'
  325.    end
  326.    ADDR.COUNT = n
  327.    call Close(out)
  328.  
  329.    do i=1 to ADDR.COUNT
  330.       Interpret 'ADDR.'i'= GetListAddr(ADDR.'i')'
  331.    End
  332.  
  333.    Interpret 'EVENT.TONAME = GetListName(Choice)'
  334.  
  335.    AddressStr = ADDR.1
  336.    Do i = 2 to ADDR.COUNT
  337.       Interpret 'NextAddress = ADDR.'i
  338.       if Length(AddressStr','NextAddress) > 250 then
  339.       do
  340.      EVENT.TOADDR = AddressStr
  341.      Call WriteCC ; leave
  342.       End
  343.       else AddressStr = AddressStr','
  344.       AddressStr = AddressStr||NextAddress
  345.    End
  346.    EVENT.TOADDR = AddressStr
  347.  
  348.    Address BBSREAD
  349.    'GetGlobalData STEM "'BD'"'
  350.    if(rc ~= 0) then
  351.    do
  352.     Address(Thorport)
  353.     'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_Ok"'
  354.     Call WaitStuff
  355.    end
  356.  
  357.    SigFile = BD.SIGNATURE
  358.  
  359.    Call Open out, SigFile, 'R'
  360.  
  361.    do while ~eof(out)
  362.       Sig = ReadLN(out)
  363.       Call Open in, DataPath||EVENT.MSGFILE, 'A'
  364.  
  365.       VPos = LastPos('$', Sig); VPos = VPos-1
  366.  
  367.       if ( Index(Sig, '$ver') ~= 0 ) then
  368.       do
  369.      Sig = DelStr(Sig, VPos, 5)
  370.      Sig = Insert(' ', Sig, VPos)
  371.      Sig = Insert($vers, Sig, VPos )
  372.       end
  373.  
  374.       if ( Index(Sig, '$time') ~= 0) then
  375.       do
  376.      Sig = DelStr(Sig, VPos, 6)
  377.      Sig = Insert(' ', Sig, VPos)
  378.      Sig = Insert($tim, Sig, VPos)
  379.       end
  380.       Call WriteLN in, Sig
  381.    end
  382.  
  383.    Call Close out
  384.    Call Close in
  385.  
  386.    Address(ThorPort)
  387.    'REQUESTSTRING TITLE "Please enter your subject:" BT "_Ok|_Cancel" ID "DLManager v1.7" MAXCHARS 100'
  388.    EVENT.SUBJECT = result
  389.    if( rc ~= 0 | EVENT.SUBJECT = '') then
  390.       EVENT.SUBJECT = '(No Subject)' /* You always have to have a subject! */
  391.  
  392.    'StartEditor 'DataPath||EVENT.MSGFILE  /* Start whatever configured editor you are using */
  393.  
  394.    Address BBSREAD
  395.    'WRITEBREVENT bbsname "'TB_SYSTEM'" event 'EVE_ENTERMSG' stem 'EVENT''
  396.    if(rc ~= 0) then
  397.    do
  398.       Address(ThorPort)
  399.       'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  400.       Call WaitStuff
  401.    end
  402. Return
  403.  
  404. DeleteList:
  405.    Address(ThorPort)
  406.  
  407.    Call GetSystemPath()
  408.  
  409.    'RequestFile Title "Select the .tdl file to delete" ID "'DataPath'" FP PAT "#?.tdl"'
  410.    if(rc = 5) then
  411.    do
  412.       'RequestNotify Text "File Delete Aborted!" BT "_Whew!"'
  413.       Call WaitStuff
  414.    end
  415.  
  416.    Address Command 'Run <>NIL: Delete 'result
  417.    'RequestNotify Text "File Deleted!" BT "_I Know!"'
  418. Return
  419.  
  420. Quit:
  421.    Address(ThorPort)
  422.  
  423.    'RequestNotify Text "Do you really\nwant to quit?" BT "_Yes|_No!"'
  424.    if(rc ~= 0) then
  425.    do
  426.       'RequestNotify Text "'THOR.LASTERROR'" BT "_OK"'
  427.       Call WaitStuff
  428.    end
  429.  
  430.    if ( result = 0 ) then Call WaitStuff
  431.    if ( result = 1 ) then Call Cleanup
  432. Return
  433.  
  434. SYNTAX:
  435.    SAY 'SYNTAX ERROR'
  436.    SAY 'Error 'rc' in line 'sigl': 'errortext(rc)
  437. HALT:
  438. Cleanup:
  439.    Call CloseWindow(DLHOST)
  440.    fini = 1
  441.    Address(ThorPort)
  442.    'ThorToFront'
  443.    Exit
  444.  
  445. GetListName: procedure
  446.          parse arg name
  447.  
  448.    psn = Lastpos('/', name)
  449.    psn = psn+1
  450.    listname = substr(name, psn)
  451.  
  452.    len = Length(listname)
  453.  
  454.    posn = len-4
  455.    lname = left(listname, posn)
  456. Return(lname)
  457.  
  458. GetListAddr: procedure
  459.          parse arg addr
  460.  
  461.    pesn = Lastpos(' ', addr)
  462.    pesn = pesn+1
  463.    listaddr = substr(addr, pesn)
  464.  
  465.    lent = Length(listaddr)
  466.  
  467.    laddr = left(listaddr, lent)
  468. Return(laddr)
  469.  
  470. AutoManAdd:
  471.    Address(ThorPort)
  472.  
  473.    'RequestNotify Text "    Do you want to\n    Manually add or\nAdd from User Database?" BT "_Manually|_Add from UDB"'
  474.    if(rc ~= 0) then
  475.    do
  476.       'RequestNotify Text "'THOR.LASTERROR'" BT "_OK"'
  477.       Call Cleanup
  478.    end
  479.  
  480.    if ( result = 0 ) then call AddUDB
  481.    if ( result = 1 ) then Call AddMan
  482. return
  483.  
  484. AddUDB:
  485.    Address BBSREAD
  486.    Call GetSystemPath()
  487.  
  488.    'SearchBRUser BBSNAME "'TB_SYSTEM'" Stem "'SResult'" Search "#?" Address'
  489.    if(rc ~= 0) then
  490.    Do
  491.       Address(ThorPort)
  492.       'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  493.       Call WaitStuff
  494.    End
  495.  
  496.    if(result > 0) then
  497.    Do
  498.        Address BBSREAD
  499.  
  500.        drop LIST.
  501.        drop USERTAGS.
  502.  
  503.        LIST.COUNT = SResult.COUNT
  504.  
  505.        Do j=1 to SResult.COUNT
  506.       LIST.j.USERNR = SResult.j.USERNR
  507.       'READBRUSER BBSNAME "'TB_SYSTEM'" UserNR "'SResult.j.USERNR'" TagsStem "'USERTAGS'"'
  508.       if(rc ~= 0) then
  509.       Do
  510.          Address(ThorPort)
  511.          'RequestNotify Text "'BBSREAD.LASTERROR'" BT "_OK"'
  512.          Call WaitStuff
  513.       End
  514.         LIST.j = USERTAGS.ADDRESS
  515.        End
  516.  
  517.        Address(ThorPort)
  518.        'REQUESTLIST instem "'LIST'" outstem "'USER'" Title "Get User:" MultiSelect'
  519.        if(rc ~= 0) then
  520.        Do
  521.       'RequestNotify Text "Command Cancelled" BT "_OK"'
  522.       Call WaitStuff
  523.        End
  524.    End
  525.  
  526.    if ~Exists(Choice) then
  527.    do
  528.       Call Open out, Choice, 'W'
  529.       Call Close out
  530.    end
  531.  
  532.    Call Open Out, Choice, 'A'
  533.  
  534.    Do k = 1 to USER.COUNT
  535.       Call WriteLN out, USER.k
  536.    End
  537.    Call Close out
  538. Return
  539.  
  540. AddMan:
  541.    Address(ThorPort)
  542.  
  543.    Call GetSystemPath()
  544.  
  545.    'RequestString TITLE "Enter E-Mail Address:" BT "_OK|_Cancel" ID "tbouchar@ptialaska.net"'
  546.    if(rc ~= 0) then
  547.    do
  548.       'RequestNotify TEXT "Command Canceled!" BT "_I Know!"'
  549.       Call WaitStuff
  550.    end
  551.  
  552.    email = result
  553.  
  554.    if ~Exists(Choice) then
  555.    do
  556.       Call Open out, Choice, 'W'
  557.       Call WriteLN out, email
  558.       Call Close out
  559.    end
  560.  
  561.    Call Open out, Choice, 'A'
  562.    Call WriteLN out, email
  563.    Call Close out
  564. Return
  565.  
  566. About:
  567.    Call GetVersion()
  568.    Address(ThorPort)
  569.    'RequestNotify TEXT "Distribution List Manager v1.7\n     by Troy E. Bouchard\n EMail: tbouchar@ptialaska.net\nThor v'VER.THOR', BBSRead.Library v'VER.BBSREAD'" BT "Thanks!"'
  570. return
  571.  
  572. Edit:
  573.    Call AddTDL
  574.    Address(ThorPort)
  575.  
  576.    'StartEditor 'Choice
  577. return
  578.  
  579. GetSystemPath:
  580.    Address BBSREAD
  581.    'GetBBSData "'TB_SYSTEM'" STEM "'GC'"'
  582.    If(rc ~= 0) then
  583.    do
  584.     address(thorport)
  585.     'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_Ok"'
  586.     Call WaitStuff
  587.    end
  588.  
  589.    DataPath = GC.BBSPATH
  590. Return(DataPath)
  591.  
  592. GetSystem:
  593.    Address BBSREAD
  594.  
  595.    'GETBBSLIST stem "'BBSLIST'"'
  596.    if(rc ~= 0) then
  597.    do
  598.     address(thorport)
  599.     'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_Ok"'
  600.     Call WaitStuff
  601.    end
  602.  
  603.    Address(ThorPort)
  604.    'REQUESTLIST instem "'BBSLIST'" title "Select System:" SizeGadget'
  605.    if(rc ~= 0) then
  606.    do
  607.       Address(ThorPort)
  608.       'RequestNotify Text "Command Cancelled" BT "_OK"'
  609.       Call WaitStuff
  610.    end
  611.  
  612.    TB_SYSTEM = result
  613. Return(TB_SYSTEM)
  614.  
  615. DelUser:
  616.    Call AddTDL()
  617.  
  618.    Drop LIST.
  619.  
  620.    Call Open out, Choice, 'R'
  621.  
  622.    m = 0
  623.    do while ~eof(out)
  624.       ListName = readln(out)
  625.       if ListName = '' then leave
  626.       m = m+1
  627.       Interpret 'LIST.'m' = ListName'
  628.    end
  629.  
  630.    LIST.COUNT = m
  631.    call Close(out)
  632.  
  633.    Drop SELECTED.
  634.    SELECTED.COUNT = 0
  635.  
  636.    Address(ThorPort)
  637.    'REQUESTLIST Instem LIST Outstem SELECTED Title "Select User(s) to Delete" MultiSelect'
  638.    if rc = 5 then Return
  639.    if rc > 0 then
  640.    Do
  641.       'RequestNotify Text "'THOR.LASTERROR'" BT "OK"'
  642.       Call WaitStuff
  643.    end
  644.  
  645.    TmpFile = 'T:del.tmp'
  646.    Call Open out, TmpFile, 'W'
  647.    Call Close out
  648.  
  649.    do j=1 to LIST.COUNT
  650.       if SELECTED.1 ~= LIST.j then
  651.       do
  652.      Call Open out, TmpFile, 'A'
  653.      Call WriteLN out, LIST.j
  654.      Call Close out
  655.       end
  656.    end
  657.  
  658.    Address Command 'Copy >NIL: 'TmpFile Choice
  659.    Address Command 'Delete >NIL: 'TmpFile
  660. Return
  661.  
  662. GetVersion:
  663.    Address(ThorPort)
  664.    'Version STEM "'VER'"'
  665.    if(rc ~= 0) then
  666.    do
  667.     'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  668.     Call WaitStuff
  669.    end
  670. Return
  671.